home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / midas060 / samples / delphi / gplmain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-16  |  3.1 KB  |  145 lines
  1. unit gplmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls, ExtCtrls;
  8.  
  9. type
  10.   Tgplform = class(TForm)
  11.     LoadButton: TButton;
  12.     OpenDialog: TOpenDialog;
  13.     PlayButton: TButton;
  14.     StopButton: TButton;
  15.     PosTrack: TTrackBar;
  16.     UpdateTimer: TTimer;
  17.     procedure LoadButtonClick(Sender: TObject);
  18.     procedure PlayButtonClick(Sender: TObject);
  19.     procedure StopButtonClick(Sender: TObject);
  20.     procedure PosTrackChange(Sender: TObject);
  21.     procedure UpdateTimerTimer(Sender: TObject);
  22.   private
  23.     { Private declarations }
  24.   public
  25.     { Public declarations }
  26.   end;
  27.  
  28. var
  29.   gplform: Tgplform;
  30.  
  31. procedure MIDASerror;
  32.  
  33. implementation
  34.  
  35. uses midasdll;
  36.  
  37. var
  38.    module : MIDASmodule;
  39.    playing : boolean;
  40.  
  41. procedure MIDASerror;
  42. var
  43.    message : PChar;
  44. begin
  45.      message := MIDASgetErrorMessage(MIDASgetLastError);
  46.      Application.MessageBox(message, 'MIDAS error', MB_OK or MB_ICONSTOP);
  47.      MIDASclose;
  48.      halt;
  49. end;
  50.  
  51. {$R *.DFM}
  52.  
  53. procedure Tgplform.LoadButtonClick(Sender: TObject);
  54. var
  55.   cfilename : array[0..256] of char;
  56.   info : MIDASmoduleInfo;
  57.   captxt : string[64];
  58. begin
  59.   if OpenDialog.Execute then
  60.   begin
  61.     StrPCopy(cfilename, OpenDialog.FileName);
  62.     if module <> NIL then begin
  63.       if not MIDASstopModule(module) then
  64.         midasError;
  65.       if not MIDASfreeModule(module) then
  66.         midasError;
  67.       module := NIL;
  68.     end;
  69.  
  70.     module := MIDASloadModule(cfilename);
  71.     if module = NIL then begin
  72.       Application.MessageBox(MIDASgetErrorMessage(MIDASgetLastError),
  73.         'Module loading error', MB_OK or MB_ICONSTOP);
  74.       exit;
  75.     end;
  76.  
  77.     if not MIDASplayModule(module, 0) then
  78.       MIDASerror;
  79.     playing := true;
  80.  
  81.     if not MIDASgetModuleInfo(module, @info) then
  82.       MIDASerror;
  83.  
  84.     captxt := info.songName;
  85.     gplform.Caption := captxt;
  86.  
  87.     PosTrack.Enabled := true;
  88.     PosTrack.Min := 0;
  89.     PosTrack.Max := info.songLength - 1;    
  90.   end;
  91. end;
  92.  
  93. procedure Tgplform.PlayButtonClick(Sender: TObject);
  94. begin
  95.   if (not playing) and (module <> NIL) then
  96.   begin
  97.     if not MIDASplayModule(module, 0) then
  98.       MIDASerror;
  99.     playing := true;
  100.     PosTrack.Enabled := true;
  101.   end;
  102. end;
  103.  
  104.  
  105.  
  106. procedure Tgplform.StopButtonClick(Sender: TObject);
  107. begin
  108.     if (playing) and (module <> NIL) then
  109.     begin
  110.         if not MIDASstopModule(module) then
  111.             MIDASerror;
  112.         playing := false;
  113.         PosTrack.Enabled := false;
  114.     end;
  115. end;
  116.  
  117.  
  118. procedure Tgplform.PosTrackChange(Sender: TObject);
  119. begin
  120.     if playing then
  121.     begin
  122.         if not MIDASsetPosition(PosTrack.Position) then
  123.             MIDASerror;
  124.     end;
  125. end;
  126.  
  127. procedure Tgplform.UpdateTimerTimer(Sender: TObject);
  128. var
  129.     state : MIDASplayStatus;
  130. begin
  131.     if playing then
  132.     begin
  133.         if not MIDASgetPlayStatus(@state) then
  134.             MIDASerror;
  135.         if state.position <> PosTrack.position then
  136.             PosTrack.position := state.position;
  137.     end;
  138. end;
  139.  
  140.  
  141. begin
  142.   module := NIL;
  143.   playing := false;
  144. end.
  145.